home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
blaise.zip
/
SAVER.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1992-05-01
|
3KB
|
143 lines
Unit Saver;
interface
uses WinProcs, WinTypes, wObjects, BWCC;
const
sc_ScreenSave = $F140;
type
PConfigDialog = PWindowsObject;
PSApplication = ^TApplication;
TSApplication = object(TApplication)
Configure: Boolean;
procedure MessageLoop; virtual;
procedure Idle; virtual;
end;
PScrnSavWindow = ^TScrnSavWindow;
TScrnSavWindow = Object(TWindow)
BackGroundColor: integer;
First:Boolean;
prevPt:TPoint;
PCfgDialog : PConfigDialog;
constructor Init(aParent:PWindowsObject; aTitle:PChar);
destructor Done;virtual;
function GetClassName: PChar; virtual;
procedure GetWindowClass(var aWndClass: TWndClass); virtual;
procedure SetupWindow; virtual;
procedure DefWndProc(var Msg: TMessage); virtual;
procedure WMSyscommand(var Msg: TMessage); virtual WM_SysCommand;
procedure Animate; virtual;
end;
implementation
procedure TSApplication.MessageLoop;
var
Message: TMsg;
begin
while True do
begin
if PeekMessage(Message, 0, 0, 0, pm_Remove) then
begin
if Message.Message = wm_Quit then
begin
Status := Message.WParam;
Exit;
end;
if not ProcessAppMsg(Message) then
begin
TranslateMessage(Message);
DispatchMessage(Message);
end;
end
else
Idle;
end;
end;
procedure TSApplication.Idle;
begin
if (Configure = false) and (MainWindow <> nil) then
PScrnSavWindow(MainWindow)^.Animate;
end;
constructor TScrnSavWindow.Init(aParent: PWindowsObject; aTitle: PChar);
begin
TWindow.Init(aParent, aTitle);
First := True;
ShowCursor(False);
Attr.Style := WS_POPUP;
end;
destructor TScrnSavWindow.Done;
begin
ShowCursor(True);
TWindow.Done;
end;
function TScrnSavWindow.GetClassName: PChar;
begin
GetClassName := 'ScreenSaverClass';
end;
procedure TScrnSavWindow.GetWindowClass(var aWndClass:TWndClass);
begin
TWindow.GetWindowClass(aWndClass);
aWndClass.hIcon := 0 ;
aWndClass.Style := cs_SaveBits;
aWndClass.hbrBackground := GetStockObject(BackGroundColor);
end;
procedure TScrnSavWindow.SetupWindow;
var
rc: TRect;
begin
TWindow.SetupWindow;
GetCursorPos(PrevPt);
GetWindowRect(GetDesktopWindow, rc);
MoveWindow(hWindow, rc.Left, rc.Top, rc.Right, rc.Bottom,True);
end;
procedure TScrnSavWindow.DefWndProc(Var Msg:TMessage);
begin
case msg.Message of
WM_MOUSEMOVE:
if (MAKEPOINT(msg.LParam).x <> prevPt.x) or
(MAKEPOINT(msg.LParam).y <> prevPt.y) then
if Not First then
PostMessage(HWindow, WM_CLOSE, 0, 0)
else
First := False;
WM_ACTIVATE,
WM_ACTIVATEAPP:
if ( msg.WParam = 0 ) then
begin
TWindow.DefWndProc(Msg);
exit;
end;
WM_KEYDOWN,
WM_SYSKEYDOWN,
WM_LBUTTONDOWN,
WM_MBUTTONDOWN,
WM_RBUTTONDOWN: PostMessage(HWindow, WM_CLOSE, 0, 0);
end;
TWindow.DefWndProc(Msg);
end;
procedure TScrnSavWindow.WMSyscommand(var Msg: TMessage);
begin
if ((Msg.WParam and $FFF0) = SC_ScreenSave) then
Msg.Result := 1
else
DefWndProc(Msg);
end;
procedure TScrnSavWindow.Animate;
begin
end;
end.